准备工作

# 清除工作环境
cat("\014");rm(list = ls())
# 设置工作目录
setwd("E:/code/DATA130003.01 Intro to Statistical Learning&ML/HW10")

一、数据读取

# 读入数据
data <- read.csv('soccer.csv', header = T, fileEncoding = "utf-8")
predictor <- data[,4:ncol(data)]  # 提取变量

二、绘制自变量的相关系数图

# 计算相关系数
cor_matrix <- cor(predictor, use = "complete.obs")

# 绘制相关系数图
COLOR01<- colorRampPalette(c("#5081ff","#638dff","#b1c6ff","#c3d5ff" ,"#ffffff", "#f7cccc","#f1aeac","#eb8b8a","#e66a68"))(100)
corrplot::corrplot(cor_matrix, method = "circle", tl.col = 'black', tl.cex = 0.45, tl.srt = 30, col = COLOR01, tl.offset = 0.4)

由变量相关系数图可见,射门、射正进球两两之间正相关性都很强,偷球带球摆脱解围封堵铲断拦截之间的正相关性较强。呈负相关关系的变量则不明显。

三、主成分分析

1. 选择主成分分析的因子数目

# 绘制崖底碎石图
scr <- scree(predictor, factors = F, pc = T,  main = "主成分分析崖底碎石图", hline = -1)

# 计算累计方差贡献率
cumvar <- round(cumsum(scr$pcv)/sum(scr$pcv), 2)
cat('前3个主成分累计方差贡献率为:', cumvar[1:3])
## 前3个主成分累计方差贡献率为: 0.45 0.72 0.81

由崖底碎石图,拐点出现在\(k=4\)处,结合第3个主成分的累计方差贡献率已经达到80%,可以选择主成分个数为3。

2. 提取主成分

pc <- principal(predictor, nfactors = 3)
pc
## Principal Components Analysis
## Call: principal(r = predictor, nfactors = 3)
## Standardized loadings (pattern matrix) based upon correlation matrix
##            RC1   RC2   RC3   h2    u2 com
## 射门      0.56  0.00  0.78 0.93 0.071 1.8
## 射正      0.47 -0.06  0.85 0.95 0.052 1.6
## 进球      0.35 -0.05  0.87 0.89 0.114 1.3
## 偷球      0.78 -0.09  0.45 0.82 0.184 1.6
## 关键传球  0.84 -0.04  0.30 0.79 0.207 1.3
## 带球摆脱  0.82 -0.07  0.24 0.74 0.259 1.2
## 助攻      0.73 -0.04  0.33 0.64 0.360 1.4
## 被侵犯    0.76  0.21  0.26 0.69 0.314 1.4
## 解围     -0.14  0.93 -0.05 0.89 0.112 1.0
## 拦截      0.33  0.82 -0.29 0.86 0.137 1.6
## 封堵     -0.12  0.89 -0.05 0.81 0.187 1.0
## 头球     -0.03  0.79  0.38 0.76 0.235 1.4
## 铲断      0.61  0.61 -0.27 0.82 0.176 2.4
## 
##                        RC1  RC2  RC3
## SS loadings           4.27 3.40 2.92
## Proportion Var        0.33 0.26 0.22
## Cumulative Var        0.33 0.59 0.81
## Proportion Explained  0.40 0.32 0.28
## Cumulative Proportion 0.40 0.72 1.00
## 
## Mean item complexity =  1.5
## Test of the hypothesis that 3 components are sufficient.
## 
## The root mean square of the residuals (RMSR) is  0.05 
##  with the empirical chi square  496.61  with prob <  5.1e-79 
## 
## Fit based upon off diagonal values = 0.99

由上面的输出结果,我们可以考虑每个主成分中变量的载荷,以对各个主成分的含义进行解释,如下:

第一主成分(RC1):在如下分量上有较高载荷:偷球(0.78)、关键传球(0.84)、带球摆脱(0.82)、助攻(0.73)、被侵犯(0.76)。这些主要与球场上的进攻相关,而且相对于直接进球得分,更侧重于创造得分机会、摆脱防守以及吸引对手犯规等方面的技术。因此,第一主成分可以反映球员的进攻创造力。

第二主成分(RC2):在解围(0.93)、拦截(0.82)、封堵(0.89)、头球(0.79)上分量较大。这些都是防守端的技能,涉及到阻止对手进攻和保护己方球门。因此,第二主成分代表的是球员的防守能力。

第三主成分(RC3):主要在射门(0.78)、进球(0.87)、射正(0.85)等分量有较大。这些直接关系到比赛的得分,因此第三主成分反映了球员的进攻效率。

结果中的Cumulative Var显示,前三个主成分的累计方差贡献率达到了80%,因此使用这三个主成分可以很好地概括和解释这组数据。

四、计算主成分得分

# 计算每一位球员的主成分得分
pc <- principal(predictor, nfactors = 3, scores = TRUE)
player <- pc$scores  # 所有球员
head(player)  # 展示前六位球员
##             RC1        RC2          RC3
## [1,] -0.8424595 -0.2233330  0.927948834
## [2,]  0.5153910  1.3545565 -0.005611217
## [3,]  0.1629058  0.4043090 -1.000455491
## [4,] -1.1544502 -0.2903471 -0.164643400
## [5,] -0.4028482 -0.8583368 -0.421757865
## [6,] -0.8933919 -0.8250419 -0.508040687

以第一位球员为例,他的进攻效率因子得分较高,说明他是较为高效的得分手,但进攻创造力因子得分较低,说明他不太善于创造得分机会,可能在与队友配合方面不足,需要再练习关键技术。

第二位球员则在防守能力因子上得分较高,说明他可能是球队的主要防守,而他在得分效率上就表现平平。同时从RC1来看,他又在进攻创造力上有一定技能。这可能是球队内专业分工训练的结果。

第六位球员则在每个因子上的得分都十分低于平均水平,说明他可能并非球队内的关键角色,想要有所突破还需要加强训练,强化长处,弥补不足。

五、K-means聚类

# 使用主成分得分,对球员进行K-means聚类
k <- 3
set.seed(123)
km <- kmeans(player, centers = k)
cat('聚类结果各类球员数为:', km$size)
## 聚类结果各类球员数为: 799 552 212
km$centers
##          RC1        RC2        RC3
## 1 -0.4500592 -0.6202597 -0.2370144
## 2  0.3233349  1.0142169 -0.3844285
## 3  0.8543226 -0.3031142  1.8942410
# 可视化聚类结果
player_df <- as.data.frame(player)
player_df$cluster <- km$cluster
centers <- data.frame(km$centers)
names(centers) <- c("RC1", "RC2", "RC3")
centers$cluster <- 1:nrow(centers)
plot_ly(data = player_df, x = ~RC1, y = ~RC2, z = ~RC3, color = ~factor(cluster), colors = c('#3357FF', '#33FF57', '#FF5733'), marker = list(size = 4)) %>%
  add_markers() %>%
  add_markers(data = centers, x = ~RC1, y = ~RC2, z = ~RC3, marker = list(size = 8, color = 'black', symbol = 'diamond')) %>%
  layout(scene = list(
    xaxis = list(title = "PC1"),
    yaxis = list(title = "PC2"),
    zaxis = list(title = "PC3")
  ))

聚类结果表明,第一类球员(蓝色)人数占比约为51.1%,占大多数,按我们的主成分分析结果应该是进攻创造力好,但聚类中心表明他们的三个主成分均值差异不明显,且略低于平均水平(0),这可能是因为创造进球机会本身要兼顾进攻和防守,且大多数球员处于各方面均衡,但都不太突出的状态。

第二类(绿色)占比约35.3%,数据和图均显示他们的PC2得分要明显比另两类高,说明这部分球员防守能力较为出色。

第三类(红色)占比约13.6%,是最少的,图中显示他们的PC3得分明显更高,且存在非常高的离群值,说明进攻能力和成功率是足球运动员最难得的品质,而且球员之间的差距也很大。